home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 001-010 / amok06 / iffsupport / demos / saveiff.mod < prev    next >
Text File  |  1993-11-04  |  13KB  |  421 lines
  1. (*---------------------------------------------------------------------------
  2.     :Program.    SaveIFF.mod
  3.     :Author.     Fridtjof Siebert
  4.     :Address.    Nobileweg 67, D-7-Stgt-40
  5.     :Phone.      0711/822509
  6.     :Shortcut.   [fbs]
  7.     :Version.    1.0
  8.     :Date.       26-Jun-88
  9.     :Copyright.  PD
  10.     :Language.   Modula-II
  11.     :Translator. M2Amiga
  12.     :Imports.    none.
  13.     :UpDate.     none.
  14.     :Contents.   Speichert Screens und Windows als IFF-Files.
  15.     :Remark.     Demonstartion für IFFSupport.
  16. ---------------------------------------------------------------------------*)
  17.  
  18. MODULE SaveIFF;
  19.  
  20. FROM SYSTEM     IMPORT ADR, ADDRESS, BITSET, LONGSET, SHIFT, CAST;
  21. FROM Arts       IMPORT TermProcedure, Assert;
  22.  
  23. FROM Intuition  IMPORT IntuitionBase, NewWindow, OpenWindow, CloseWindow,
  24.                        WindowFlags, WindowFlagSet, Gadget, GadgetFlags,
  25.                        GadgetFlagSet, WindowPtr, ActivationFlags,
  26.                        ActivationFlagSet, ScreenFlags, ScreenFlagSet,
  27.                        IDCMPFlags, IDCMPFlagSet, RefreshGadgets, strGadget,
  28.                        StringInfo, IntuiMessagePtr, GadgetPtr, ScreenPtr,
  29.                        boolGadget, CloseScreen, DisplayBeep;
  30. FROM Graphics   IMPORT Text, Move, Draw, SetAPen, SetDrMd, jam1, jam2,
  31.                        RastPortPtr, SetBPen, Rectangle, RectFill;
  32. FROM Exec       IMPORT OpenLibrary, CloseLibrary, WaitPort, GetMsg, ReplyMsg,
  33.                        LibraryPtr;
  34. FROM Dos        IMPORT Delay;
  35.  
  36. FROM Strings    IMPORT Length, Copy, first, last;
  37.  
  38. FROM IFFSupport IMPORT ReadILBM, ReadILBMFlags, ReadILBMFlagSet, WriteILBM;
  39.  
  40. TYPE
  41.   Gadgets = (scrn0,scrn1,scrn2,scrn3,scrn4,scrn5,scrn6,scrn7,scrn8,scrn9,
  42.              wind0,wind1,wind2,wind3,wind4,wind5,wind6,wind7,wind8,wind9,
  43.              name, savescrn, savewind, savegzz, showiff, dummy);
  44.  
  45. VAR
  46.   Intuitionbase: POINTER TO IntuitionBase;   (* IntuitionBasePtr           *)
  47.   NuWindow: NewWindow;
  48.   Window: WindowPtr;                         (* SaveIFF's Window        *)
  49.   RP: RastPortPtr;                           (* It's RastPort              *)
  50.   Gadgs: ARRAY Gadgets OF Gadget;            (* It's Gadgets               *)
  51.   NameInfo: StringInfo;                      (* IFF-Name's Gadget's Info   *)
  52.   Name: ARRAY[0..79] OF CHAR;                (* IFF-Name                   *)
  53.   IDCount: Gadgets;                          (* Counting Gadgets           *)
  54.   ChosenScreen, ChosenWindow: Gadgets;       (* User-Selected Screnn&Window*)
  55.   Screen: ScreenPtr;                         (* Screen for Loaded IFF-File *)
  56.   DummyWind: WindowPtr;                      (* only a Dummy               *)
  57.   Screens: ARRAY[scrn0..scrn9] OF ScreenPtr; (* ScreenPtrs                 *)
  58.   Windows: ARRAY[wind0..wind9] OF WindowPtr; (* WindowPtrs                 *)
  59.   NumScreens, NumWindows: Gadgets;           (* How many are in that List? *)
  60.   gadget: GadgetPtr;                         (* Gadget causing a Message   *)
  61.   Msg: IntuiMessagePtr;                      (* Receives Messages          *)
  62.   Rect: Rectangle;                           (* Rectangle for Windows      *)
  63.   Ciapra [0BFE001H]: SET OF (s0,s1,s2,s3,s4,s5,lmb);
  64.  
  65. (*-----------------------  Small Procedures:  -----------------------------*)
  66.  
  67. (*------  Set a Bool-Gadget:  ------*)
  68.  
  69. PROCEDURE SetBool(VAR Gadg: Gadget; x,y,w,h: INTEGER);
  70.  
  71. BEGIN
  72.   WITH Gadg DO
  73.     nextGadget := NIL;
  74.     leftEdge := x;  topEdge := y;
  75.     width    := w;  height  := h;
  76.     flags    := GadgetFlagSet{};
  77.     activation   := ActivationFlagSet{gadgImmediate,toggleSelect};
  78.     gadgetType   := boolGadget;
  79.     gadgetRender := NIL;
  80.     selectRender := NIL;
  81.     gadgetText   := NIL;
  82.     mutualExclude:= LONGSET{};
  83.     specialInfo  := NIL;
  84.     gadgetID     := 0;
  85.     userData     := NIL;
  86.   END;
  87. END SetBool;
  88.  
  89. (*------  Draw A Box:  ------*)
  90.  
  91. PROCEDURE Box(rp: RastPortPtr; x,y,X,Y: INTEGER);
  92.  
  93. BEGIN
  94.   Move(rp,x,y); Draw(rp,X,y); Draw(rp,X,Y); Draw(rp,x,Y); Draw(rp,x,y);
  95. END Box;
  96.  
  97. (*------  Type Text:  ------*)
  98.  
  99. TYPE
  100.   TypeTextType = POINTER TO ARRAY[0..999] OF CHAR;
  101.  
  102. PROCEDURE Type(rp: RastPortPtr; x,y: INTEGER; text:TypeTextType);
  103.  
  104. BEGIN
  105.   Move(rp,x,y); Text(rp,text,Length(text^));
  106. END Type;
  107.  
  108. (*-------------------------------------------------------------------------*)
  109. (*                                                                         *)
  110. (*                      Refresh Display: (Gadgets & Names)                 *)
  111. (*                                                                         *)
  112. (*-------------------------------------------------------------------------*)
  113.  
  114. PROCEDURE Refresh(Display: BOOLEAN);
  115. (* IF NOT(Display) THEN Don't make anything affecting the display          *)
  116.  
  117. VAR
  118.   SearchScreen: ScreenPtr;
  119.   SearchWindow: WindowPtr;
  120.   SearchName: ARRAY[0..79] OF CHAR;
  121.   NamePtr: POINTER TO ARRAY[0..255] OF CHAR;
  122.  
  123. BEGIN
  124.  
  125. (*------  Delete highlighted Gadgets:  ------*)
  126.  
  127.   IF Display THEN RefreshGadgets(ADR(Gadgs),Window,NIL) END;
  128.  
  129. (*------  Get ScreenNames:  ------*)
  130.  
  131.   IF Display THEN
  132.     SetAPen(RP,0); SetDrMd(RP,jam1); RectFill(RP,9,27,143,109);
  133.     SetAPen(RP,1); SetBPen(RP,0); SetDrMd(RP,jam2);
  134.   END;
  135.   IDCount := scrn0;
  136.   SearchScreen := Intuitionbase^.firstScreen;
  137.   WHILE (SearchScreen#NIL) AND (IDCount<=scrn9) DO
  138.     Screens[IDCount] := SearchScreen;
  139.     IF SearchScreen^.title=NIL THEN
  140.       SearchName := "Unnamed";
  141.     ELSE
  142.       NamePtr := SearchScreen^.title;
  143.       Copy(SearchName,NamePtr^,first,16);
  144.     END;
  145.     IF Display THEN Type(RP, 12,35+8*ORD(IDCount),ADR(SearchName)) END;
  146.     INC(IDCount);
  147.     SearchScreen := SearchScreen^.nextScreen;
  148.   END;
  149.   NumScreens := IDCount;
  150.   IF ChosenScreen>=NumScreens THEN ChosenScreen := scrn0 END;
  151.  
  152. (*------  Get WindowNames:  ------*)
  153.  
  154.   IF Display THEN
  155.     SetAPen(RP,0); SetDrMd(RP,jam1); RectFill(RP,153,27,287,109);
  156.     SetAPen(RP,1); SetBPen(RP,0); SetDrMd(RP,jam2);
  157.   END;
  158.   IDCount := wind0;
  159.   SearchWindow := Screens[ChosenScreen]^.firstWindow;
  160.   WHILE (SearchWindow#NIL) AND (IDCount<=wind9) DO
  161.     Windows[IDCount] := SearchWindow;
  162.     IF SearchWindow^.title=NIL THEN
  163.       SearchName := "Unnamed";
  164.     ELSE
  165.       NamePtr := SearchWindow^.title;
  166.       Copy(SearchName,NamePtr^,first,16);
  167.     END;
  168.     IF Display THEN Type(RP,156,8*ORD(IDCount)-45,ADR(SearchName)) END;
  169.     INC(IDCount);
  170.     SearchWindow := SearchWindow^.nextWindow;
  171.   END;
  172.   NumWindows := IDCount;
  173.   IF ChosenWindow>=NumWindows THEN
  174.     IF NumWindows=wind0 THEN
  175.       ChosenWindow := dummy;
  176.     ELSE
  177.       ChosenWindow := wind0;
  178.     END;
  179.   END;
  180.  
  181. (*------  Set Gadgets:  ------*)
  182.  
  183.   IF Display THEN
  184.     FOR IDCount := scrn0 TO showiff DO
  185.       EXCL(Gadgs[IDCount].flags,selected);
  186.     END;
  187.     INCL(Gadgs[ChosenScreen].flags,selected);
  188.     INCL(Gadgs[ChosenWindow].flags,selected);
  189.   END;
  190.  
  191. (*------  Refresh:  ------*)
  192.  
  193.   IF Display THEN RefreshGadgets(ADR(Gadgs),Window,NIL) END;
  194.  
  195. END Refresh;
  196.  
  197. (*--------------------------  Clean Up:  ----------------------------------*)
  198.  
  199. PROCEDURE CleanUp();
  200.  
  201. BEGIN
  202.   IF Intuitionbase#NIL THEN CloseLibrary(LibraryPtr(Intuitionbase)) END;
  203.   IF Window#NIL THEN CloseWindow(Window) END;
  204.   IF Screen#NIL THEN CloseScreen(Screen) END;
  205. END CleanUp;
  206.  
  207. (*-------------------------------------------------------------------------*)
  208. (*                                                                         *)
  209. (*                             M A I N :                                   *)
  210. (*                                                                         *)
  211. (*-------------------------------------------------------------------------*)
  212.  
  213. BEGIN
  214.  
  215. (*------  Init Variables:  ------*)
  216.  
  217.   Window := NIL;
  218.   Intuitionbase := NIL;
  219.   Screen := NIL;
  220.   TermProcedure(CleanUp);
  221.   Name := "df0:Pic.iff";
  222.   ChosenScreen := scrn0;
  223.   ChosenWindow := wind0;
  224.  
  225. (*------  Open Intuition:  ------*)
  226.  
  227.   Intuitionbase := ADDRESS(OpenLibrary(ADR("intuition.library"),33));
  228.   Assert(Intuitionbase#NIL,ADR("SaveIFF: Can't open Intuition"));
  229.  
  230. (*------------------------  Build up Display:  ----------------------------*)
  231.  
  232. (*------  Gadgets: ------*)
  233.  
  234.   FOR IDCount:=scrn0 TO scrn9 DO
  235.     SetBool(Gadgs[IDCount],9,29+8*ORD(IDCount),135,8);
  236.     SetBool(Gadgs[Gadgets(ORD(IDCount)+ORD(wind0))],153,29+8*ORD(IDCount),
  237.             135,8);
  238.   END;
  239.   SetBool(Gadgs[name    ], 60,116,224, 8);
  240.   WITH Gadgs[name] DO
  241.     activation  := ActivationFlagSet{stringCenter};
  242.     gadgetType  := strGadget;
  243.     specialInfo := ADR(NameInfo);
  244.   END;
  245.   WITH NameInfo DO
  246.     buffer := ADR(Name);
  247.     undoBuffer := NIL;
  248.     bufferPos  := 0;
  249.     maxChars   := 80;
  250.     dispPos    := 0;
  251.     numChars   := Length(Name);
  252.   END;
  253.   SetBool(Gadgs[savescrn],  9,131,135,11);
  254.   SetBool(Gadgs[savewind],153,131,135,11);
  255.   SetBool(Gadgs[savegzz ],  9,147,135,11);
  256.   SetBool(Gadgs[showiff ],153,147,135,11);
  257.  
  258. (*------  Link Gadgets:  ------*)
  259.  
  260.   FOR IDCount := scrn0 TO savegzz DO
  261.     WITH Gadgs[IDCount] DO
  262.       nextGadget := ADR(Gadgs[Gadgets(ORD(IDCount)+1)]);
  263.       gadgetID := ORD(IDCount);
  264.     END;
  265.   END;
  266.   WITH Gadgs[showiff] DO
  267.     nextGadget := NIL;
  268.     gadgetID := ORD(showiff)
  269.   END;
  270.  
  271. (*------  Window:  ------*)
  272.  
  273.   WITH NuWindow DO
  274.     leftEdge   := 172;  topEdge   := 36;
  275.     width      := 296;  height    := 164;
  276.     detailPen  := 0;    blockPen  := 1;
  277.     idcmpFlags := IDCMPFlagSet{gadgetDown,closeWindow};
  278.     flags      := WindowFlagSet{windowDrag,windowDepth,windowClose,activate,
  279.                                 noCareRefresh};
  280.     firstGadget:= ADR(Gadgs);
  281.     checkMark  := NIL;
  282.     title      := ADR("SaveIFF - © F. Siebert");
  283.     screen     := NIL;
  284.     bitMap     := NIL;
  285.     type       := ScreenFlagSet{wbenchScreen};
  286.   END;
  287.  
  288.   Window := OpenWindow(NuWindow);
  289.   Assert(Window#NIL,ADR("SaveIFF: Can't open Window"));
  290.   RP := Window^.rPort;
  291.  
  292. (*------  Draw into Window:  ------*)
  293.  
  294.   SetAPen(RP,2); SetDrMd(RP,jam1);
  295.   Box(RP,  8, 26,144,110); Box(RP,152, 26,288,110);
  296.   Box(RP, 56,114,288,126); Box(RP,  8,130,144,142);
  297.   Box(RP,152,130,288,142); Box(RP,  8,146,144,158);
  298.   Box(RP,152,146,288,158);
  299.  
  300. (*------  Type Text into Window:  ------*)
  301.  
  302.   SetAPen(RP,1);
  303.   Type(RP,  8, 23,ADR("Screens:"));
  304.   Type(RP,152, 23,ADR("Windows:"));
  305.   Type(RP,  8,123,ADR("Name:"));
  306.   Type(RP, 36,139,ADR("Save Screen"));
  307.   Type(RP,180,139,ADR("Save Window"));
  308.   Type(RP, 28,155,ADR("Save GimmeZZ"));
  309.   Type(RP,188,155,ADR("Show IFF"));
  310.  
  311. (*------  Initialize Display:  ------*)
  312.  
  313.   Refresh(TRUE);
  314.  
  315. (*----------------------------  Get Messages:  ----------------------------*)
  316.  
  317.   LOOP
  318.  
  319.     WaitPort(Window^.userPort);
  320.     Msg := GetMsg(Window^.userPort);
  321.     IF closeWindow IN Msg^.class THEN
  322.       ReplyMsg(Msg);
  323.       EXIT;
  324.     END;
  325.     gadget := Msg^.iAddress;
  326.     ReplyMsg(Msg);
  327.  
  328.     IDCount := Gadgets(gadget^.gadgetID);
  329.  
  330.     CASE IDCount OF
  331.  
  332. (*------  Screen-Gadget:  ------*)
  333.  
  334.     scrn0..scrn9:
  335.       IF IDCount<NumScreens THEN
  336.         ChosenScreen := IDCount;
  337.       ELSE
  338.         DisplayBeep(NIL);
  339.       END; |
  340.  
  341. (*------  Window-Gadget:  ------*)
  342.  
  343.     wind0..wind9:
  344.       IF IDCount<NumWindows THEN
  345.         ChosenWindow := IDCount;
  346.       ELSE
  347.         DisplayBeep(NIL);
  348.       END; |
  349.  
  350. (*------  SaveScrn:  ------*)
  351.  
  352.     savescrn:
  353.       Refresh(FALSE);
  354.       WITH Screens[ChosenScreen]^ DO
  355.         IF NOT(WriteILBM(Name,ADR(rastPort),ADR(viewPort),NIL,TRUE)) THEN
  356.           DisplayBeep(NIL);
  357.         END;
  358.       END; |
  359.  
  360. (*------  savewind:  ------*)
  361.  
  362.     savewind:
  363.       Refresh(FALSE);
  364.       IF ChosenWindow#dummy THEN
  365.         WITH Windows[ChosenWindow]^ DO
  366.           WITH Rect DO
  367.             minX := leftEdge;
  368.             minY := topEdge;
  369.             maxX := minX + width - 1;
  370.             maxY := minY + height - 1;
  371.           END;
  372.           IF NOT(WriteILBM(Name,rPort,ADR(wScreen^.viewPort),ADR(Rect),
  373.                  TRUE)) THEN
  374.             DisplayBeep(NIL);
  375.           END;
  376.         END;
  377.       ELSE
  378.         DisplayBeep(NIL);
  379.       END; |
  380.  
  381. (*------  Save GimmeZeroZero:  ------*)
  382.  
  383.     savegzz:
  384.       Refresh(FALSE);
  385.       IF ChosenWindow#dummy THEN
  386.         WITH Windows[ChosenWindow]^ DO
  387.           WITH Rect DO
  388.             minX := leftEdge + ORD(borderLeft);
  389.             minY := topEdge + ORD(borderTop);
  390.             maxX := minX + gzzWidth - 1;
  391.             maxY := minY + gzzHeight - 1;
  392.           END;
  393.           IF NOT(WriteILBM(Name,rPort,ADR(wScreen^.viewPort),ADR(Rect),
  394.                  TRUE)) THEN
  395.             DisplayBeep(NIL);
  396.           END;
  397.         END;
  398.       ELSE
  399.         DisplayBeep(NIL);
  400.       END; |
  401.  
  402. (*------  ShowIFF:  ------*)
  403.  
  404.     showiff:
  405.       IF ReadILBM(Name,ReadILBMFlagSet{front,visible},Screen,DummyWind) THEN
  406.          WHILE lmb IN Ciapra DO Delay(5) END; (* Wait for Left Button *)
  407.          CloseScreen(Screen);
  408.          Screen := NIL;
  409.       ELSE
  410.         DisplayBeep(NIL);
  411.       END; |
  412.  
  413.     ELSE
  414.     END;
  415.  
  416.     Refresh(TRUE);
  417.  
  418.   END;   (* LOOP *)
  419.  
  420. END SaveIFF.
  421.